home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 10 / FM Towns Free Software Collection 10.iso / fb386 / lib / blb / sample / window.bas < prev   
Encoding:
BASIC Source File  |  1995-02-18  |  11.6 KB  |  205 lines
  1. 10  CLEAR,,,0,0,0:CLEAR,,,FRE(4)*.8!,,100000:DEF FONT"システム   12ﾄﾞｯﾄ":DEFINT A-Z
  2. 20  SCREEN 0:SCREEN@0:LINE(0,0)-(1023,19),PSET,%7,BF:BLB_MENUBAR_XLONG%=100
  3. 30    PALETTE 1,[112,32,176]:PALETTE 6,[192,192,192]:PALETTE 7,[112,112,112]
  4. 40    PALETTE 8,[32,32,32]:PALETTE 9,[176,128,224]:PALETTE 15,[255,255,255]
  5. 50  BLB_RESO_X=640:BLB_RESO_Y=480:GOSUB *BLB_WIN_INIT
  6. 60  FOR I=2 TO 9:READ W(I):NEXT:W$="Window Library v1.30"
  7. 70 *LOOP
  8. 75  LOCATE 0,0:PRINT USING "右クリックでウィンドウを開きます。(###/###)";LEN(BLB_WIN$);BLB_WIN_MAX
  9. 80  GOSUB *BLB_WIN_WORK
  10. 90  IF MOUSE(2,1) THEN W(0)=RND*320-30:W(1)=RND*300+24:GOSUB *BLB_WIN_OPEN:WHILE MOUSE(2,1):WEND
  11. 100  GOTO *LOOP
  12. 110  DATA 320,240,240,60,640,480,0,0
  13. 120 '
  14. 60400 '------------------- マウスカーソル形状設定 ver 1.60 一画面モード専用 --------------------------
  15. 60401 '入力 mousepat = マウスパターン番号
  16. 60402 '                (0=通常 1=時計 2=鉛筆 3=手 4=毛抜き 5=スポイト 6=指 7=筆 8=カッター)
  17. 60403 '                ( 負数はアイコン番号(絶対値)。絵柄については TOWNS GEARﾃﾞｨｸｼｮﾅﾘ参照)
  18. 60404 '                (         ただし､負数を指定したときは読み取り位置の補正は行われない)
  19. 60405 *BLB_MOUSEPAT
  20. 60406  IF BLB_MOUSEPAT%=0 THEN DIM BLB_MA&(31),BLB_MD&(31):MOUSE 0:MOUSE 1,320,240,0:BLB_MOUSEPAT%=1
  21. 60407  MOUSE 3,0,INP(&H3B06):MOUSE 3,1,INP(&H3B06)
  22. 60408  IF MOUSEPAT<0 THEN *BLB_MOUSEPAT2
  23. 60409  FOR I%=0 TO 31:BLB_MA&(I%)=PEEK([264]&H2D080+I%*4+MOUSEPAT*256,4)
  24. 60410  BLB_MD&(I%)=BLB_MA&(I%) OR PEEK([264]&H2D000+MOUSEPAT*256+I%*4,4) XOR -1
  25. 60411  NEXT:MOUSE 1,,,1
  26. 60412  MOUSE 6,0,BLB_MA&,BLB_MD&,ASC(MID$("1?1:21111",MOUSEPAT+1))-48,ASC(MID$("1?1:L111N",MOUSEPAT+1))-48:RETURN
  27. 60413 *BLB_MOUSEPAT2
  28. 60414  FOR I%=0 TO 31:BLB_MA&(I%)=PEEK([264]&H27F80+I%*4-MOUSEPAT*256,4)
  29. 60415  BLB_MD&(I%)=(BLB_MA&(I%)XOR-1)AND(PEEK([264]&H27F00-MOUSEPAT*256+I%*4,4)XOR-1)
  30. 60416  NEXT:MOUSE 1,,,1:MOUSE 6,0,BLB_MA&,BLB_MD&,15,15:RETURN
  31. 60800 '-------------------- Ｗｉｎｄｏｗライブラリ version 1.30 (16色画面用) ---------------------
  32. 60801 *BLB_WIN_INIT
  33. 60802  '入力 BLB_RESO_X    ･･･ 画面解像度(横ドット数)
  34. 60803  '     BLB_RESO_Y    ･･･ 画面解像度(縦ドット数)
  35. 60804  '     BLB_WIN_MAX   ･･･ 最大ウィンドウ数(255未満･0のとき自動設定)
  36. 60805  VIEW(0,0)-(BLB_RESO_X-1,BLB_RESO_Y-1):WINDOW(0,0)-(BLB_RESO_X-1,BLB_RESO_Y-1)
  37. 60806  COLOR 7,0,7,4:CONSOLE 0,25,0:LINE(0,-(BLB_MENUBAR_XLONG%>0)*20)-(1023,767),PSET,%6,BF
  38. 60807  MOUSEPAT=0:GOSUB *BLB_MOUSEPAT
  39. 60808  BLB_WINMEM&=BLB_RESO_X*BLB_RESO_Y/4
  40. 60809  IF BLB_WIN_MAX=0 THEN BLB_WIN_MAX=((FRE(3)-200000)*.8!)\BLB_WINMEM&*2
  41. 60810  BLB_WIN$="":BLB_WIN_EXIST$=STRING$(BLB_WIN_MAX,"0")
  42. 60811  BLB_MEM%(0)=9:ERASE BLB_MEM%:BLB_WINPTN%(0)=0:ERASE BLB_WINPTN%
  43. 60812  DIM BLB_WIN%(BLB_WIN_MAX,9),BLB_WINTITLE$(BLB_WIN_MAX),BLB_MEM%(78000)
  44. 60813  DIM BLB_WINPTN%(BLB_WINMEM&*(BLB_WIN_MAX+1)-1)
  45. 60814  RETURN
  46. 60815 *BLB_WIN_POS
  47. 60816  IF BLB_WIN$="" THEN W=-1:RETURN
  48. 60817  FOR I%=1 TO LEN(BLB_WIN$):A%=ASC(MID$(BLB_WIN$,I%,1))-1
  49. 60818   IF X<BLB_WIN%(A%,0) OR X>=BLB_WIN%(A%,0)+BLB_WIN%(A%,2) OR Y<BLB_WIN%(A%,1) OR Y>=BLB_WIN%(A%,1)+BLB_WIN%(A%,3) THEN NEXT:W=-1:RETURN
  50. 60819   I%=256:NEXT:W=A%+1:GOSUB *BLB_WIN_WSET:X=X-W(0):Y=Y-W(1):RETURN
  51. 60820 *BLB_WIN_OPEN
  52. 60821  IF LEN(BLB_WIN$)=BLB_WIN_MAX THEN W=-1:RETURN
  53. 60822  W=INSTR(BLB_WIN_EXIST$,"0"):BLB_WIN$=CHR$(W)+BLB_WIN$
  54. 60823  FOR I%=0 TO 9:BLB_WIN%(W-1,I%)=W(I%):NEXT:BLB_WINTITLE$(W-1)=W$
  55. 60824  MID$(BLB_WIN_EXIST$,W,1)="1":GOSUB *BLB_WIN_DRAW:RETURN
  56. 60825 *BLB_WIN_CLOSE
  57. 60826  IF BLB_WIN$="" THEN RETURN
  58. 60827  W=ASC(BLB_WIN$):GOSUB *BLB_WIN_WSET
  59. 60828  BLB_V%(0)=W(0):BLB_V%(1)=W(1):BLB_V%(2)=W(0)+W(2)-1:BLB_V%(3)=W(1)+W(3)-1
  60. 60829  GOSUB *BLB_WIN_BACKDRAW
  61. 60830  MID$(BLB_WIN_EXIST$,W,1)="0":BLB_WIN$=MID$(BLB_WIN$,2)
  62. 60831  RETURN
  63. 60832 *BLB_WIN_MOVE
  64. 60833  IF BLB_WIN$="" THEN RETURN
  65. 60834  W=ASC(BLB_WIN$):GOSUB *BLB_WIN_WSET:BLB_WIN%(W-1,0)=X:BLB_WIN%(W-1,1)=Y
  66. 60835  GET@A(W(0),W(1))-(W(0)+W(2)-1,W(1)+W(3)-1),BLB_WINPTN%,BLB_WINMEM&*(W-1)
  67. 60836  IF W(0)<0 OR W(0)+W(2)>BLB_RESO_X OR W(1)+W(3)>BLB_RESO_Y THEN
  68. 60837   BLB_MEM%(0)=X:BLB_MEM%(1)=Y:FOR I%=0 TO 9:BLB_MEM%(I+2)=W(I%):NEXT
  69. 60838   GOSUB *BLB_WIN_DRAW:X=BLB_MEM%(0):Y=BLB_MEM%(1)
  70. 60839   FOR I%=0 TO 9:W(I%)=BLB_MEM%(I+2):NEXT
  71. 60840  ELSE
  72. 60841   PUT@A(X,Y)-(X+W(2)-1,Y+W(3)-1),BLB_WINPTN%,,,,,BLB_WINMEM&*(W-1)
  73. 60842  ENDIF
  74. 60843  BLB_V%(0)=W(0):BLB_V%(2)=W(0)+W(2)-1
  75. 60844  IF ABS(W(0)-X)>=W(2) OR ABS(W(1)-Y)>W(3)-2 THEN
  76. 60845   BLB_V%(1)=W(1):BLB_V%(3)=W(1)+W(3)-1:GOSUB *BLB_WIN_BACKDRAW
  77. 60846  ELSE
  78. 60847   FOR I%=0 TO 3:BLB_MEM%(I%)=W(I%):NEXT
  79. 60848   IF Y<W(1) THEN
  80. 60849    BLB_V%(1)=Y+W(3)-1:BLB_V%(3)=W(1)+W(3)-1:GOSUB *BLB_WIN_BACKDRAW
  81. 60850   ELSE IF Y>W(1) THEN
  82. 60851    BLB_V%(1)=W(1):BLB_V%(3)=Y:GOSUB *BLB_WIN_BACKDRAW
  83. 60852   ENDIF
  84. 60853   FOR I%=0 TO 3:W(I%)=BLB_MEM%(I%):NEXT
  85. 60854   IF Y<W(1) THEN BLB_V%(1)=W(1):BLB_V%(3)=Y+W(3)-1 ELSE BLB_V%(1)=Y:BLB_V%(3)=W(1)+W(3)-1
  86. 60855   IF X>W(0) THEN
  87. 60856    BLB_V%(0)=W(0):BLB_V%(2)=X:GOSUB *BLB_WIN_BACKDRAW
  88. 60857   ELSE IF X<W(0) THEN
  89. 60858    BLB_V%(0)=X+W(2)-1:BLB_V%(2)=W(0)+W(2)-1:GOSUB *BLB_WIN_BACKDRAW
  90. 60859   ENDIF
  91. 60860  ENDIF
  92. 60861  W=ASC(BLB_WIN$):GOSUB *BLB_WIN_WSET:LINE(W(0),W(1))-STEP(W(2)-1,W(3)-1),PSET,%8,B
  93. 60862  RETURN
  94. 60863 *BLB_WIN_SIZE
  95. 60864  IF BLB_WIN$="" THEN RETURN
  96. 60865  W=ASC(BLB_WIN$):GOSUB *BLB_WIN_WSET:IF W(2)=X AND W(3)=Y THEN RETURN
  97. 60866  IF X<W(4) OR X>W(6) OR Y<W(5) OR Y>W(7) THEN RETURN
  98. 60867  BLB_WIN%(W-1,2)=X:BLB_WIN%(W-1,3)=Y:BLB_V%(0)=W(2):BLB_V%(1)=W(3):GOSUB *BLB_WIN_DRAW
  99. 60868  W(2)=BLB_V%(0):W(3)=BLB_V%(1):IF X>=W(2) AND Y>=W(3) THEN RETURN
  100. 60869  IF X>=W(2) AND Y<W(3) THEN
  101. 60870   BLB_V%(0)=W(0):BLB_V%(1)=W(1)+Y-1:BLB_V%(2)=W(0)+W(2)-1:BLB_V%(3)=W(1)+W(3)-1
  102. 60871  ELSE IF X<W(2) AND Y>=W(3) THEN
  103. 60872   BLB_V%(0)=W(0)+X-1:BLB_V%(1)=W(1):BLB_V%(2)=W(0)+W(2)-1:BLB_V%(3)=W(1)+W(3)-1
  104. 60873  ELSE IF X<W(2) AND Y<W(3) THEN
  105. 60874   BLB_V%(0)=W(0):BLB_V%(1)=W(1)+Y-1:BLB_V%(2)=W(0)+W(2)-1:BLB_V%(3)=W(1)+W(3)-1
  106. 60875   A%=W(2):GOSUB *BLB_WIN_BACKDRAW
  107. 60876   BLB_V%(0)=W(0)+X-1:BLB_V%(1)=W(1):BLB_V%(2)=W(0)+A%-1:BLB_V%(3)=W(1)+Y-1
  108. 60877  ENDIF
  109. 60878  GOSUB *BLB_WIN_BACKDRAW:LINE(W(0),W(1))-STEP(W(2)-1,W(3)-1),PSET,%8,B:RETURN
  110. 60879 *BLB_WIN_CHANGE
  111. 60880  IF BLB_WIN$="" THEN RETURN
  112. 60881  IF W<1 OR W>BLB_WIN_MAX OR W=ASC(BLB_WIN$) THEN RETURN
  113. 60882  I%=INSTR(BLB_WIN$,CHR$(W)):IF I%=0 THEN RETURN
  114. 60883  BLB_WIN$=CHR$(W)+LEFT$(BLB_WIN$,I%-1)+MID$(BLB_WIN$,I%+1)
  115. 60884  PUT@A(W(0),W(1))-(W(0)+W(2)-1,W(1)+W(3)-1),BLB_WINPTN%,,,,,BLB_WINMEM&*(W-1):RETURN
  116. 60885 *BLB_WIN_DRAW
  117. 60886  GOSUB *BLB_WIN_WSET
  118. 60887  MOUSE 1,,,0:LINE(W(0),W(1))-STEP(W(2)-1,W(3)-1),PSET,%8,BF,7
  119. 60888  LINE(W(0),W(1))-STEP(W(2)-1,15),PSET,%8,BF
  120. 60889  LINE(W(0)+LEN(BLB_WINTITLE$(W-1))*6+40,W(1)+1)-(W(0)+W(2)-2,W(1)+14),PSET,1,BF
  121. 60890  CONNECT(W(0),W(1)+W(3)-2)-STEP(W(2)-3,0)-STEP(0,2-W(3))-STEP(1,0)-STEP(0,W(3)-2),%8
  122. 60891  SYMBOL(W(0)+24,W(1)+2),BLB_WINTITLE$(W-1),.75!,.75!,7
  123. 60892  IF (W(8) AND 2)=0 THEN
  124. 60893   LINE(W(0)+2,W(1)+2)-STEP(11,11),PSET,7,BF,%6
  125. 60894   LINE STEP(0,0)-STEP(-11,-11),PSET,7:LINE STEP(11,0)-STEP(-11,11),PSET,7
  126. 60895  ENDIF
  127. 60896  GOSUB *BLB_WIN_USERDRAW:GOSUB *BLB_WIN_GTOMEM:MOUSE 1,,,1:RETURN
  128. 60897 *BLB_WIN_BACKDRAW
  129. 60898  IF BLB_V%(0)<0 THEN IF BLB_V%(2)<1 THEN RETURN ELSE BLB_V%(0)=0
  130. 60899  IF BLB_V%(1)<0 THEN BLB_V%(1)=0 ELSE IF BLB_V%(1)>BLB_RESO_Y-2 THEN RETURN
  131. 60900  IF BLB_V%(0)>BLB_RESO_X-2 THEN RETURN
  132. 60901  IF BLB_V%(2)>BLB_RESO_X-2 THEN BLB_V%(2)=BLB_RESO_X-1
  133. 60902  IF BLB_V%(3)>BLB_RESO_Y-2 THEN BLB_V%(3)=BLB_RESO_Y-1
  134. 60903  MOUSE 1,,,0:VIEW(BLB_V%(0),BLB_V%(1))-(BLB_V%(2),BLB_V%(3)),%6
  135. 60904  WINDOW(BLB_V%(0),BLB_V%(1))-(BLB_V%(2),BLB_V%(3))
  136. 60905  W=ASC(BLB_WIN$):GOSUB *BLB_WIN_WSET:I%=LEN(BLB_WIN$)
  137. 60906  WHILE I%>1:W=ASC(MID$(BLB_WIN$,I%,1))-1:I%=I%-1
  138. 60907   PUT@A(BLB_WIN%(W,0)-BLB_V%(0),BLB_WIN%(W,1)-BLB_V%(1))-(BLB_WIN%(W,0)+BLB_WIN%(W,2)-1-BLB_V%(0),BLB_WIN%(W,1)+BLB_WIN%(W,3)-1-BLB_V%(1)),BLB_WINPTN%,,,,,BLB_WINMEM&*W
  139. 60908  WEND
  140. 60909  W=ASC(BLB_WIN$):GOSUB *BLB_WIN_WSET:VIEW:WINDOW:MOUSE 1,,,1:RETURN
  141. 60910 *BLB_WIN_WSET
  142. 60911  FOR I%=0 TO 9:W(I%)=BLB_WIN%(W-1,I%):NEXT:RETURN
  143. 60912 *BLB_WIN_GTOMEM
  144. 60913  W=ASC(BLB_WIN$):GOSUB *BLB_WIN_WSET
  145. 60914  GET@A(W(0),W(1))-(W(0)+W(2)-1,W(1)+W(3)-1),BLB_WINPTN%,BLB_WINMEM&*(W-1):RETURN
  146. 60915 *BLB_WIN_WORK
  147. 60916  IF MOUSE(2,0)=0 OR BLB_WIN$="" THEN RETURN
  148. 60917  X=MOUSE(0):Y=MOUSE(1):GOSUB *BLB_WIN_POS:IF W<0 THEN WHILE MOUSE(2,0):WEND:RETURN
  149. 60918  IF W<>ASC(BLB_WIN$) THEN GOSUB *BLB_WIN_CHANGE:RETURN
  150. 60919  IF X>W(2)-4 OR Y<16 OR Y>W(3)-3 THEN
  151. 60920   IF X>0 AND Y>1 AND X<13 AND Y<14 AND (W(8) AND 2)=0 THEN
  152. 60921    B%=0:WHILE MOUSE(2,0):X=MOUSE(0)-W(0):Y=MOUSE(1)-W(1)
  153. 60922     A%=(X>1)*(X<13)*(Y>1)*(Y<13)
  154. 60923     IF A%<>B% THEN LINE(W(0)+2,W(1)+2)-STEP(11,11),XOR,%7,BF:B%=A%
  155. 60924    WEND:IF B%=1 THEN GOSUB *BLB_WIN_CLOSE
  156. 60925   ELSE IF Y<16 AND (W(8)AND 1)=0 THEN
  157. 60926    MOUSEPAT=3:GOSUB *BLB_MOUSEPAT
  158. 60927    MOUSE 4,0,Y-(BLB_MENUBAR_XLONG%>0)*20,BLB_RESO_X-1,BLB_RESO_Y-9
  159. 60928    LINE(W(0),W(1))-STEP(W(2)-1,W(3)-1),XOR,%7,B
  160. 60929    C%=X:D%=Y:WHILE MOUSE(2,0):A%=MOUSE(0)-W(0):B%=MOUSE(1)-W(1)
  161. 60930     IF A%<>C% OR B%<>D% THEN
  162. 60931      LINE(W(0)-X+C%,W(1)-Y+D%)-STEP(W(2)-1,W(3)-1),XOR,%7,B:C%=A%:D%=B%
  163. 60932      LINE(W(0)-X+C%,W(1)-Y+D%)-STEP(W(2)-1,W(3)-1),XOR,%7,B
  164. 60933     ENDIF
  165. 60934    WEND:LINE(W(0)-X+C%,W(1)-Y+D%)-STEP(W(2)-1,W(3)-1),XOR,%7,B
  166. 60935    MOUSEPAT=0:GOSUB *BLB_MOUSEPAT:MOUSE 4,0,0,BLB_RESO_X-1,BLB_RESO_Y-1
  167. 60936    IF X<>C% OR Y<>D% THEN X=W(0)-X+C%:Y=W(1)-Y+D%:GOSUB *BLB_WIN_MOVE
  168. 60937   ELSE IF (X>W(2)-4 OR Y>W(3)-3) AND (W(8) AND 4)=0 THEN
  169. 60938    A%=W(0)+W(4)+X-W(2)+1:B%=W(1)+W(5)+Y-W(3):C%=W(0)+W(6)+X-W(2):D%=W(1)+W(7)+Y-W(3)
  170. 60939    A%=-A%*(A%>=0):B%=-B%*(B%>=0):IF C%>BLB_RESO_X-2 THEN C%=BLB_RESO_X-1
  171. 60940    IF D%>BLB_RESO_Y-2 THEN D%=BLB_RESO_Y-1
  172. 60941    MOUSEPAT=4:GOSUB *BLB_MOUSEPAT:LINE(W(0),W(1))-STEP(W(2)-1,W(3)-1),XOR,%7,B
  173. 60942    MOUSE 4,A%,B%,C%,D%:C%=X:D%=Y:WHILE MOUSE(2,0):A%=MOUSE(0)-W(0):B%=MOUSE(1)-W(1)
  174. 60943     IF A%<>C% OR B%<>D% THEN
  175. 60944      LINE(W(0),W(1))-STEP(W(2)-X+C%-1,W(3)-Y+D%-1),XOR,%7,B:C%=A%:D%=B%
  176. 60945      LINE(W(0),W(1))-STEP(W(2)-X+C%-1,W(3)-Y+D%-1),XOR,%7,B
  177. 60946     ENDIF
  178. 60947    WEND:MOUSEPAT=0:GOSUB *BLB_MOUSEPAT:LINE(W(0),W(1))-STEP(W(2)-X+C%-1,W(3)-Y+D%-1),XOR,%7,B
  179. 60948    MOUSE 4,0,0,BLB_RESO_X-1,BLB_RESO_Y-1:X=W(2)-X+C%:Y=W(3)-Y+D%:GOSUB *BLB_WIN_SIZE
  180. 60949   ENDIF
  181. 60950  ELSE
  182. 60951   GOSUB *BLB_WIN_USER:WHILE MOUSE(2,0):WEND
  183. 60952  ENDIF
  184. 60953  RETURN
  185. 60954 *BLB_WIN_USER
  186. 60955  '┌───────────────────────────────────┐
  187. 60956  '│以下に、ウィンドウ内がマウスでクリックされた場合に行う処理を          │
  188. 60957  '│記述してください。                                                    │
  189. 60958  '│ウィンドウの座標は（W(0),W(1)）～（W(0)+W(2)-1,W(1)+W(3)-1）です。    │
  190. 60959  '│ウィンドウについての情報は登録時と同じ形式で W() に収録されています。 │
  191. 60960  '└───────────────────────────────────┘
  192. 60980  RETURN
  193. 60981 *BLB_WIN_USERDRAW
  194. 60982  '┌───────────────────────────────────┐
  195. 60983  '│以下に、ウィンドウ内に描画するルーチンを記述してください。            │
  196. 60984  '│ウィンドウの座標は（W(0),W(1)）～（W(0)+W(2)-1,W(1)+W(3)-1）です。    │
  197. 60985  '│ウィンドウについての情報は登録時と同じ形式で W() に収録されています。 │
  198. 60986  '│  (例) SYMBOL(W(0)+16,W(1)+32),STR$(W),3,3,3                          │
  199. 60987  '└───────────────────────────────────┘
  200. 60988  LINE(W(0)+1,W(1)+16)-STEP(W(2)-5,W(3)-19),PSET,2
  201. 60989  LINE(W(0)+W(2)-4,W(1)+16)-STEP(5-W(2),W(3)-19),PSET,3
  202. 60990  SYMBOL(W(0)+8,W(1)+24),"ウィンドウの右端･下端の影の部分で",.75!,.75!,%8
  203. 60991  SYMBOL(W(0)+24,W(1)+40),"ウィンドウの大きさを変更できます。",.75!,.75!,%8
  204. 60999  RETURN
  205.